Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/cocktail/lalr.lha/lalr/src/Lookahead.mi

Text File | 1992-08-18 | 16KB | 715 lines

(* compute LALR(1) lookahead sets *)

(* $Id: Lookahead.mi,v 2.3 1992/08/07 15:22:49 grosch rel $ *)

(* $Log: Lookahead.mi,v $
 * Revision 2.3  1992/08/07  15:22:49  grosch
 * allow several scanner and parsers; extend module Errors
 *
 * Revision 2.2  1991/11/21  14:53:14  grosch
 * new version of RCS on SPARC
 *
 * Revision 2.1  91/09/23  11:48:22  grosch
 * renamed module LALR to Lookahead
 *
 * Revision 2.0  91/03/08  18:31:46  grosch
 * turned tables into initialized arrays (in C)
 * moved mapping tokens -> strings from Errors to Parser
 * changed interface for source position
 *
 * Revision 1.1  90/06/12  16:54:24  grosch
 * renamed main program to lalr, added { } for actions, layout improvements
 *
 * Revision 1.0     88/10/04  14:36:29  vielsack
 * Initial revision
 *
 *)

IMPLEMENTATION MODULE Lookahead;

FROM SYSTEM    IMPORT ADR, TSIZE;
FROM Limits    IMPORT MaxShortCard;
FROM Errors    IMPORT eFatal, eInformation, eString, eInternal, ErrorMessage, ErrorMessageI;
FROM DynArray    IMPORT MakeArray, ExtendArray;
FROM Sets    IMPORT tSet, MakeSet, ReleaseSet, AssignEmpty, Include, Exclude,
            Extract, Union, Assign, IsElement, IsEmpty, ForallDo;
FROM Strings    IMPORT tString, ArrayToString;
FROM Automaton    IMPORT tIndex, tStateIndex, tItemIndex, tProdIndex, tItemIndexList,
            tProduction, tRep, tItem, StartSymbol, ItemIndex, ItemArrayPtr,
            ProdList, ProdArrayPtr, StateIndex, StateArrayPtr;
FROM Check    IMPORT CheckForConflicts;
FROM Positions    IMPORT NoPosition;
FROM TokenTab    IMPORT MINTerm, MAXTerm, MINNonTerm, MAXNonTerm, Vocabulary, Terminal,
            NonTerminal, TokenError, TokenType, GetTokenType, TokenToSymbol;

  CONST
    eConflict    = 64;
    eNotLRk    = 62;

  VAR
    Nullables        : tSet;
    reportedError    : BOOLEAN;

  PROCEDURE ComputeLALR;
    BEGIN
      ComputeNullables;            (* A *)
      MarkRep;
      ComputeDR;            (* B *)
      ComputeReads;            (* C *)
      Digraph (TreatReadConflict);    (* D *)
      CheckReadSets;
      ComputeIncludesAndLookback;    (* E *)
      Digraph (TreatFollowConflict);    (* F *)
      ComputeLA;            (* G *)
      CheckForConflicts (NoConflict);    (* H *)
    END ComputeLALR;

  PROCEDURE ComputeNullables;

  (* Berechne die Nichtterminale welche nullable sind *)

    VAR
      todo    : tSet;        (* noch zu ueberpruefende Nichterminale *)
      success    : BOOLEAN;    (* hatte der letzte Schritt Erfolg *)
      t        : Terminal;
      nt    : NonTerminal;

    PROCEDURE IsYetNullable (nt: CARDINAL);
      VAR
    u, i    : tIndex;
    pn    : tProdIndex;
    prod    : tProduction;
    ri    : Vocabulary;
    t    : Terminal;
    localsuccess    : BOOLEAN;
      BEGIN
    WITH ProdList[nt] DO
      u := Used;

      (* Betrachte alle Produktionen mit linker Seite nt *)

      localsuccess := FALSE;
      pn := 1;
      WHILE (pn <= u) AND NOT localsuccess DO

        (* Auswahl der einzelnen Produktion *)

        prod := ADR(ProdArrayPtr^[Array^[pn].Index]);
        WITH prod^ DO

          (* Pruefe ob rechte Seite in Nullables* liegt *)

          localsuccess := TRUE;
          i := 1;

          WHILE (i <= Len) AND localsuccess DO
        ri := Right [i];
        localsuccess := IsElement (ri,Nullables);
        INC (i);
          END;
        END;
        INC (pn);
      END;
    END;

    IF localsuccess THEN
      Include (Nullables, nt);
      Exclude (todo, nt);
      success := TRUE;
    END;
      END IsYetNullable;

    BEGIN
      MakeSet (todo,MAXNonTerm);
      MakeSet (Nullables,MAXNonTerm);

      (* todo = Menge aller Nichtterminale *)

      FOR nt := MINNonTerm TO MAXNonTerm DO
    IF GetTokenType (nt) = NonTerm THEN
      Include (todo,nt);
    END;
      END;

      (* Nullables := { } *)

      REPEAT
    success := FALSE;

    (* Pruefe ob jetzt ein weiteres *)
    (* Nichtterminal terminalisierbar ist *)

    FOR nt := MINNonTerm TO MAXNonTerm DO
      IF IsElement (nt, todo) THEN
        IsYetNullable (nt);
      END;
    END;
      UNTIL NOT success;    (* solange bis sich nichts aendert *)
      ReleaseSet (todo);
    END ComputeNullables;

  PROCEDURE MarkRep;

  (* Markiert Items die eine Uebergang oder eine Reduktion repraesentieren *)

    VAR
      si,s    : tStateIndex;
      p        : tProduction;
      reps    : tSet;
      i        : tItemIndex;
      RepArray    : ARRAY Vocabulary OF tItemIndex;
      voc    : Vocabulary;
    BEGIN
      MakeSet (reps,MAXNonTerm);
      si := StateIndex;
      FOR s:=1 TO si DO
    AssignEmpty (reps);
    WITH StateArrayPtr^[s] DO
      FOR i := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[i] DO
          p := ADR(ProdArrayPtr^[Prod]);
          IF Pos >= p^.Len THEN
        RepNo := i;
        Rep := RedRep;
          ELSE
        (* wird in Automaton beim Einrichten erledigt
        *** voc := p^.Right[Pos+1];
        *** Read := voc;
        *)
        voc := Read;
        IF IsElement (voc,reps) THEN
          Rep := NoRep;
          RepNo := RepArray [voc];
        ELSIF (voc >= MINTerm) AND (voc <= MAXTerm) THEN
          RepArray [voc] := i;
          RepNo := i;
          Rep := TermRep;
          Include (reps,voc);
        ELSE (* NonTerminal *)
          RepArray [voc] := i;
          RepNo := i;
          Rep := NonTermRep;
          Include (reps,voc);
        END;
          END;

          (* nur fuer diese Items werden Sets benoetigt *)

          IF (Rep = RedRep) OR (Rep=NonTermRep) THEN
        MakeSet (Set,MAXTerm);
          END;
        END;
      END;
    END;
      END;
      ReleaseSet (reps);
    END MarkRep;

  PROCEDURE ComputeDR;

  (* Berechnung der "direct read symbols" (DR) *)
  (* DR (p,A) := { t in T | p -A-> r -t-> }    *)

    VAR
      maxItem    : tItemIndex;
      pAIndex    : tItemIndex;
      pA         : tItem;
      pAProd    : tProduction;
      r        : tStateIndex;
      ir    : tItemIndex;
    BEGIN
      maxItem := ItemIndex;
      FOR pAIndex := 1 TO maxItem DO

    (* fuer alle Item - ein Item entspricht (p,A) *)

    pA := ItemArrayPtr^[pAIndex];

    (* pruefe ob pA einen Nichtterminaluebergang  repraesentiert *)

    pAProd := ADR(ProdArrayPtr^[pA.Prod]);    (* zugh. Produktion *)

    IF (pA.Rep = NonTermRep) THEN

      (* Bestimme r *)

      r := pA.Next;

      (* Berechne DR (p,A) als Menge aller in r lesbaren Terminale *)

      WITH StateArrayPtr^[r] DO   (* Zustand r *)
        FOR ir := Items TO Items + Size - 1 DO
          WITH ItemArrayPtr^[ir] DO     (* ein Item von r *)
        IF Rep = TermRep THEN
          Include (ItemArrayPtr^[pAIndex].Set,Read);
        END;
          END;        (* ein Item von r *)
        END;          (* Zustand r *)
      END;
    END;
      END;
    END ComputeDR;


  PROCEDURE ComputeReads;

  (* (p,A) reads (r,C)    falls  p -A-> r -C-> and  C => epsilon *)

    VAR
      pA, rC    : tItemIndex;
      r        : tStateIndex;
      maxItem    : tItemIndex;
    BEGIN

      (* fuer alle Items die einen Nichterminaluebergang repraesentiren *)

      maxItem := ItemIndex;
      FOR pA := 1 TO maxItem DO
    IF ItemArrayPtr^[pA].Rep = NonTermRep THEN

      (* Berechne r *)

      r := ItemArrayPtr^[pA].Next;

      (* Berechne zugh. rC's *)

      FOR rC := StateArrayPtr^[r].Items TO
            StateArrayPtr^[r].Items + StateArrayPtr^[r].Size - 1 DO

        IF ItemArrayPtr^[rC].Rep = NonTermRep THEN

          (* Pruefe ob C => Epsilon *)

          IF IsElement (ItemArrayPtr^[rC].Read,Nullables) THEN

        (* gueltiges rC gefunden *)
        (* Fuege rC zur Relation hinzu *)

        PutInRelation (pA, rC);

          END;
        END;
      END;
    END;
      END;
    END ComputeReads;

  PROCEDURE CheckReadSets;
    VAR Item, MaxItem    : tItemIndex;
    BEGIN
      MaxItem := ItemIndex;
      FOR Item := 1 TO MaxItem DO
    WITH ItemArrayPtr^[Item] DO
      IF Rep = NonTermRep THEN
        IF IsEmpty (Set) THEN
          EmptyReadSet := TRUE;
        ELSE
          EmptyReadSet := FALSE;
          MakeSet (ReadSet,MAXTerm);
          Assign (ReadSet,Set);
        END;
      END;
    END;
      END;
    END CheckReadSets;

  PROCEDURE Digraph (TreatConflict: ConflictProc);
    VAR x, maxItem    : tItemIndex;
    BEGIN

      (* let S be an initially empty stack OF elements of X *)

      ClearItemStack;

      (* let N be an ARRAY OF zeros indexd by elements of X *)

      ClearNumbers;

      (* for x in X such that N x = 0 DO *)

      maxItem := ItemIndex;
      FOR x := 1 TO maxItem DO
    WITH ItemArrayPtr^[x] DO
      IF Number = 0 THEN
        Traverse (x,TreatConflict);
      END;
    END;
      END;
    END Digraph;

  PROCEDURE Traverse ( x: tItemIndex; TreatConflict: ConflictProc);
    VAR
      d        : CARDINAL;
      ArrayIndex: tIndex;
      yIndex    : tItemIndex;
      u        : tIndex;
      Top    : tItemIndex;
      EmptyCycle,
      cyclic    : BOOLEAN;
    BEGIN
      WITH ItemArrayPtr^[x] DO

    (* Push x on S *)

    PushItem (x);

    (* con d: Depth of S *)

    d := ItemDepth();

    (* N x <- d ;    F x <- F' x *)

    Number := d;

    (* for all y in X such that x R y DO *)

    WITH Relation DO
      u := Used;
      FOR ArrayIndex := 1 TO u DO
        yIndex := Array^[ArrayIndex];

        (* if Ny = 0 then call Traverse y *)

        IF ItemArrayPtr^[yIndex].Number = 0 THEN
          Traverse (yIndex,TreatConflict);
        END;

        (* assign N x <- Min (N x, N y) ;  F x := F x union F y *)

        IF ItemArrayPtr^[yIndex].Number < Number THEN
          Number := ItemArrayPtr^[yIndex].Number;
        END;

        Union (Set,ItemArrayPtr^[yIndex].Set);
      END;
    END;

    (* IF N x = d *)

    IF Number = d THEN
      cyclic := FALSE;
      EmptyCycle := TRUE;

      (* then repeat *)

      REPEAT
        (* assign N (Top OF S) <- Infinity) ; F(Top OF S) <- F x *)

        Top := TopItem();
        ItemArrayPtr^[Top].Number := MaxShortCard;

        IF Top # x THEN
          Assign (ItemArrayPtr^[Top].Set, Set);
          cyclic := TRUE;
          EmptyCycle := EmptyCycle AND ItemArrayPtr^[Top].EmptyReadSet;
        END

      (* until (Pop OF S) = x *)

      UNTIL PopItem() = x;

      IF cyclic THEN
        EmptyCycle := EmptyCycle AND EmptyReadSet;
        TreatConflict (EmptyCycle);
      END;
    END;
      END;
    END Traverse;

  PROCEDURE ComputeIncludesAndLookback;
    VAR
      State, maxState    : tStateIndex;
      Transition, Item, RepItem    : tItemIndex;
      TransItem        : tItem;
      Production    : tProduction;
      nullable        : BOOLEAN;
    BEGIN
      (* loesche bisherige Relation fuer neue Includesrelation *)

      ClearRelation;

      (* Betrachte alle States *)

      maxState := StateIndex;
      FOR State := 1 TO maxState DO
    WITH StateArrayPtr^[State] DO

      (* Betrachte alle Nichterminaluebergaenge *)

      FOR Transition := Items TO Items + Size - 1 DO
        TransItem := ItemArrayPtr^[Transition];
        IF TransItem.Rep = NonTermRep THEN

          (* Finde Situationen deren Produktion mit dem *)
          (* zur Transition gehoerigen Nichterminal beginnen *)

          FOR Item := Items TO Items + Size - 1 DO
        WITH ItemArrayPtr^[Item] DO
          Production := ADR(ProdArrayPtr^[Prod]);
          IF (Pos = 0) AND (Production^.Left = TransItem.Read) THEN
            IF Pos < Production^.Len THEN
              WindThrough (Next,Prod,Pos+1,Transition,nullable);
              IF nullable THEN
            (* Repraesentant beschaffen *)
            RepItem := RepNo;
            (* pruefen ob Nichtterminaluebergang *)
            IF ItemArrayPtr^[RepItem].Rep = NonTermRep THEN
              (* Include zu sich selbst ausfiltern, *)
              (* da nicht konstruktiv bei Followberechnung *)
              IF (RepItem # Transition) THEN
                PutInRelation (RepItem,Transition); (* In Include eintragen *)
              END;
            END;
              END;
            ELSE
              PutInRelation (Item,Transition); (* In Lookback eintragen *)
            END;
          END;
        END;
          END;
        END;
      END;
    END;
      END;
    END ComputeIncludesAndLookback;

  PROCEDURE WindThrough (MyState: tStateIndex; MyProd: tProdIndex; MyPos: tIndex; Trans: tItemIndex; VAR nullable: BOOLEAN);
    VAR
      Item        : tItemIndex;
      Production    : tProduction;
    BEGIN
      WITH StateArrayPtr^[MyState] DO

    (* finde zugehoeriges Item *)

    Item := Items;
    LOOP
      WITH ItemArrayPtr^[Item] DO
        IF (Prod = MyProd) AND (Pos = MyPos) THEN
          EXIT;
        END;
        INC (Item);
      END;
    END;

    WITH ItemArrayPtr^[Item] DO

      (* eindeutigen Repraesentanten beschaffen *)
      (* jedoch mit speziellen (WITH-Statement) weiterarbeiten *)

      Item := ItemArrayPtr^[Item].RepNo;

      (* zugehoerige Production beschaffen *)

      Production := ADR(ProdArrayPtr^[Prod]);
      IF Pos < Production^.Len THEN

        (* Ende noch nicht ereicht *)

        WindThrough (Next, Prod, Pos+1, Trans, nullable);
        IF nullable THEN
          IF ItemArrayPtr^[Item].Rep = NonTermRep THEN

        (* Include zu sich selbst ausfiltern, *)
        (* da nicht konstruktiv bei Followberechnung *)

        IF (Item # Trans) THEN

          (* In Include eintragen *)

          PutInRelation (Item,Trans);
        END;
          END;
          nullable := IsElement (Read, Nullables);
        END;
      ELSE

        (* Ende der Produktion wurde erreicht *)

        nullable := TRUE;
        PutInRelation (Item, Trans);
      END;
    END;
      END;
    END WindThrough;

  PROCEDURE ComputeLA;
    VAR
      Index    : tIndex;
      Item    : tItemIndex;
      maxItem    : tItemIndex;
      lookbackindex    : tItemIndex;
      u        : tIndex;
    BEGIN

      (* fuer alle Items, die eine Reduktion darstellen *)

      maxItem := ItemIndex;
      FOR Item :=1 TO maxItem DO
    WITH ItemArrayPtr^[Item] DO
      IF Rep = RedRep THEN

        (* Berechne Look Ahead Set *)

        (* fuer alle Item in Lookback *)

        WITH Relation DO
          u := Used;
          FOR Index := 1 TO u DO
        lookbackindex := Array^[Index];

        (* fuege Follow(lookback) hinzu *)

        Union (Set, ItemArrayPtr^[lookbackindex].Set);
          END;
        END;
      END;
    END;
      END;
    END ComputeLA;

  PROCEDURE TreatReadConflict (empty: BOOLEAN);
  BEGIN
    IF NOT reportedError THEN
      (* do not report this fact
      ErrorMessage (eNotLRk,eInformation,0,0);
      *)
      reportedError := TRUE;
    END;
  END TreatReadConflict;

  PROCEDURE TreatFollowConflict (empty: BOOLEAN);
  BEGIN
    IF NOT empty THEN
      IF NOT reportedError THEN
    (* do not report this fact
    ErrorMessage (eNotLRk,eInformation,0,0);
    *)
    reportedError := TRUE;
      END;
    END;
  END TreatFollowConflict;

  PROCEDURE ClearRelation;
    VAR Item, maxItem    : tItemIndex;
    BEGIN
      maxItem := ItemIndex;
      FOR Item := 1 TO maxItem DO
    ItemArrayPtr^[Item].Relation.Used := 0;
      END;
    END ClearRelation;

  PROCEDURE PutInRelation (Rel: tItemIndex; NT: tItemIndex);
    VAR i, u    : tIndex;
    BEGIN

      (* zu bearbeitende Relation auswaehlen *)

      WITH ItemArrayPtr^[Rel].Relation DO

    (* pruefen ob Eintrag bereits vorhanden *)

    u := Used;
    FOR i := 1 TO u DO
      IF Array^[i] = NT THEN RETURN; END;
    END;

    (* eventuell Speicher beschaffen *)

    IF Used = 0 THEN
      MakeArray (Array,Count,TSIZE(tIndex));
    ELSIF Used >= Count THEN
      ExtendArray (Array,Count,TSIZE(tIndex));
    END;
    INC (Used);
    Array^[Used] := NT;
      END;
    END PutInRelation;

  MODULE ItemStack;

    IMPORT tItemIndexList, tItemIndex, TSIZE, MakeArray, ExtendArray, eInternal, eFatal, ERROR;

    EXPORT ClearItemStack, ItemDepth, PushItem, PopItem, TopItem;

   CONST InitItemStackCount = 10;

   VAR Stack    : tItemIndexList;

    PROCEDURE ClearItemStack;
      BEGIN
    Stack.Used := 0;
      END ClearItemStack;

    PROCEDURE PushItem (Item: tItemIndex);
      BEGIN
    WITH Stack DO
      INC (Used);
      IF Used > Count THEN
        IF Count = 0 THEN
          Count := InitItemStackCount;
          MakeArray (Array,Count,TSIZE(tItemIndex));
        ELSE
          ExtendArray (Array,Count,TSIZE(tItemIndex));
        END;
      END;
      Array^[Used] := Item;
    END;
      END PushItem;

    PROCEDURE PopItem ():tItemIndex;
      VAR Item    : tItemIndex;
      BEGIN
    WITH Stack DO
      IF Used < 1 THEN
        ERROR ('PopItem on empty Stack');
      END;
      Item := Array^[Used];
      DEC (Used);
      RETURN Item;
    END;
      END PopItem;

    PROCEDURE TopItem ():tItemIndex;
      BEGIN
    WITH Stack DO
      RETURN Array^[Used];
    END;
      END TopItem;

    PROCEDURE ItemDepth ():CARDINAL;
      BEGIN
    RETURN Stack.Used;
      END ItemDepth;

    BEGIN
      Stack.Used := 0;
      Stack.Count :=0;
    END ItemStack;

  PROCEDURE ClearNumbers;
  VAR i, maxi    : tItemIndex;
    BEGIN
      maxi := ItemIndex;
      FOR i:=1 TO maxi DO
    WITH ItemArrayPtr^[i] DO
      IF Rep = NonTermRep THEN
        Number := 0;
      ELSE
        Number := MaxShortCard;
      END;
    END;
      END;
    END ClearNumbers;

  PROCEDURE ERROR (a: ARRAY OF CHAR);
  VAR s    : tString;
  BEGIN
    ArrayToString (a, s);
    ErrorMessageI (eInternal, eFatal, NoPosition, eString, ADR (s));
  END ERROR;

BEGIN
  reportedError := FALSE;
END Lookahead.